home *** CD-ROM | disk | FTP | other *** search
/ Shareware Gold 2 / Shareware Gold II - Volume 2 Number 1 - Wayzata Technology (7071) (1991).iso / database / pds_base / utilprog.exe / lha / DBUTIL03.SRC < prev    next >
Text File  |  1990-03-10  |  4KB  |  47 lines
  1. |2010 DIM OLDFIELDS%(|02),NEWFIELDPOS%(|02,|07),OLDDETAILS%(9), NEWDETAILPOS%(|02,9)
  2. *23 2015 DIM ZHC(10), ZEC(10)
  3. |2020 ZCLONEIN%=1:BLINKNORMAL%=|28:BLINKINSERT%=|29:BLINK2%=|30 'For CGA or EGA adapter, BLINKNORMAL%=6, BLINKINSERT%=4 and BLINK2%=7. For Monochrome adapter, BLINKNORMAL%=13, BLINKINSERT%=9 and BLINK2%=14.
  4. 2030 GOSUB 3000
  5. 2040 CLS:LOCATE 1,16,0
  6. 2050 COLOR COLA%(2),COLA%(1)
  7. |2060 PRINT "PDS*BASE Data Base Clone In Program |01";:COLOR COLA%(2),0
  8. 2070 PRINT:PRINT:COLOR COLA%(2),0:PRINT "This program will Clone In records from an ASCII file created by a Clone Out":PRINT "program from a data base that has been resized.  The Clone In ASCII file"
  9. 2080 PRINT "records will include all data base file pointers."
  10. 2090 PRINT:PRINT "The files will be have the same names as the '.DAT' file(s) except":PRINT "that they will have '.PDS' as the file name extender.":PRINT:POSX%=CSRLIN+1
  11. 2100 FOR J=1 TO ZQ
  12. *23 2105 ZCHGFLAG(J)=1:FOR K=1 TO ZS%(J,7):ZI$(K,J)=STRING$(ZSIZE%(J,K),32):NEXT:IF ZS%(J,1)=1 THEN IF ZS%(J,4) > 0 THEN FOR K=1 TO ZS(J,4):ZH(K)=0:ZE(K)=0:NEXT 'blank out in case any not in old version
  13. *28 2105 ZCHGFLAG(J)=1:FOR K=1 TO ZS%(J,7):ZI$(K,J)=STRING$(ZSIZE%(J,K),32):NEXT 'blank out in case any not in old version
  14. 2110 LOCATE POSX%,7,1:COLOR COLA%(2),0:PRINT "Enter Clone-In File Drive For ";ZS$(J,1);" (Enter=Skip) ";:POSY%=POS(0):COLOR 0,COLA%(3):PRINT " ";:COLOR COLA%(2),0:PRINT ":";:LOCATE POSX%,POSY%,1:D$="":WHILE D$="":D$=INKEY$:WEND:IF ASC(D$)=13 THEN D$=""
  15. 2120 IF D$="" OR D$=" " THEN BEEP:LOCATE 24,6,0:COLOR 15,0:PRINT "No Drive Letter entered - This file will be skipped - Strike any key";:COLOR 7,0:A$=INPUT$(1):LOCATE 24,1:PRINT SPC(79):LOCATE POSX+2,1:PRINT SPC(79):GOTO 2230
  16. 2130 COLOR 0,COLA%(3):PRINT D$;:COLOR 7,0:X=INSTR(ZS$(J,1),"."):F$=D$+":"+LEFT$(ZS$(J,1),X)+"PDS":OPEN F$ FOR INPUT AS #ZQ+2:RECNUM%=0:LOCATE POSX%+3,30:PRINT "Loading Record";
  17. 2140 WHILE NOT EOF(ZQ+2) 'read each Clone In record
  18. *23 2150 IF ZS%(J,1)=2 THEN RECNUM%=RECNUM%+1:INPUT #ZQ+2, IREC, IZB$, IZF$:ZB=VAL(IZB$):ZF=VAL(IZF$)
  19. *23 2160 IF ZS%(J,1)=1 THEN IF OLDDETAILS%(J) > 0 THEN FOR K=1 TO OLDDETAILS%(J):INPUT #ZQ+2, IZH$, IZE$:ZHC(NEWDETAILPOS%(J,K))=VAL(IZH$):ZEC(NEWDETAILPOS%(J,K))=VAL(IZE$):NEXT
  20. 2170 FOR K=1 TO OLDFIELDS%(J):INPUT #ZQ+2, IZI$:LSET ZI$(NEWFIELDPOS%(J,K),J)=IZI$:NEXT
  21. *28 2180 ZR$=ZI$(ZS%(J,10),J):ZA=J:GOSUB 800:IF ZV=2 THEN LOCATE 25,1:PRINT SPC(79)
  22. *23 2180 ZA=J:IF ZS%(J,1)=1 THEN ZR$=ZI$(ZS%(J,10),J):GOSUB 800 ELSE Y1=1:ZR=IREC:GOSUB 750:ZS%(J,6)=NUMREC%:ZS%(J,8)=NUMREC%+1
  23. 2190 LOCATE POSX%+5,35,0:PRINT ZR;"     ";:IF ZV=2 THEN LOCATE 25,1:PRINT SPC(79)
  24. 2200 WEND 'end of file
  25. 2210 CLOSE ZQ+2:LOCATE POSX%+3,30:PRINT SPC(20):LOCATE POSX%+5,35,0:PRINT SPC(20)
  26. *23 2215 IF ZS%(J,1)=2 THEN ZA=J:LOCATE 24,1,0:PRINT SPC(79):LOCATE 24,15:PRINT "Must reset Detail File Pointers - Do not interrupt";:GOSUB 4000
  27. 2220 LOCATE 24,1,0:PRINT SPC(79):LOCATE 24,7:PRINT "All ";ZS$(J,1);" records Cloned In - Strike any key to continue";:A$=INPUT$(1):LOCATE 24,1,0:PRINT SPC(79)
  28. 2230 NEXT 'J - file
  29. 2240 LOCATE 23,1:GOTO 400
  30. 3000 'Subroutine to set up arrays
  31. 3010 FOR J=1 TO ZQ:READ OLDFIELDS%(J):FOR K=1 TO OLDFIELDS%(J):READ NEWFIELDPOS%(J,K):NEXT
  32. 3020 IF ZS%(J,1) = 1 THEN READ OLDDETAILS%(J):IF OLDDETAILS%(J) > 0 THEN FOR K=1 TO OLDDETAILS%(J):READ NEWDETAILPOS%(J,K):NEXT 'K
  33. 3030 NEXT 'J
  34. 3040 RETURN
  35. *57
  36. *23 4000 'Subroutine to reset Detail File Pointers
  37. *23 4010 LOCATE POSX%+3,27,0:PRINT "File * Record * Last Vacant";:ZL=ZS%(ZA,2)+1:Y2=0:FOR ZR=ZS%(ZA,2) TO 1 STEP -1
  38. *23 4020 LOCATE POSX%+5,27:PRINT ZA;TAB(35);ZR;" ";
  39. *23 4030 GOSUB 600:Y11=0:FOR ZJ=1 TO ZS%(ZA,7):IF Y$(ZJ,ZA)<>STRING$(ZSIZE%(ZA,ZJ),32) THEN Y11=1
  40. *23 4040 NEXT:IF Y11=1 THEN Y2=Y2+1:GOTO 4060
  41. *23 4050 ZF=ZL:GOSUB 700:ZL=ZR 'set the forward pointer to the next higher vacant record
  42. *23 4055 LOCATE POSX%+5,27,0:PRINT ZA;TAB(35);ZR;SPC(1);TAB(47)ZL;" ";:ZL=ZR
  43. *23 4060 NEXT:LOCATE POSX%+3,27,0:PRINT SPC(30):LOCATE POSX%+5,27,0:PRINT SPC(30)
  44. *23 4070 ZS%(ZA,6)=Y2:ZS%(ZA,8)=ZL 'reset the housekeeping pointers
  45. *23 4080 RETURN
  46. *31 Copyright 1987 by PRO DEV Software
  47.